home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE05 / CONSTRUC / TBUUCODE.ZIP / TBUUCODE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-07  |  5.9 KB  |  215 lines

  1. unit TBUUCode;
  2. { TBUUCode version 2.0 }
  3. interface
  4. uses
  5.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms,
  6.   DrBob;
  7.  
  8. type
  9.   EUUCode = class(Exception);
  10.  
  11.   TErrorEvent = procedure(Error: Word) of Object;
  12.   TSuccessEvent = procedure of Object;
  13.  
  14.  
  15.   TBUUEncode = class(TDrBob)
  16.   public
  17.   { Public class declarations (override) }
  18.     constructor Create(AOwner: TComponent); override;
  19.  
  20.   private
  21.   { Private field declarations }
  22.     FActivate: Boolean;
  23.     FOnError: TErrorEvent;
  24.     FOnSuccess: TSuccessEvent;
  25.     FInputFileName: String;
  26.     FOutputFileName: String;
  27.  
  28.   protected
  29.   { Protected method declarations }
  30.     function InputFilePChar: PChar;
  31.     function OutputFilePChar: PChar;
  32.  
  33.   protected
  34.   { Protected activation methods }
  35.     procedure Activation(Engage: Boolean);
  36.  
  37.   public
  38.   { Public interface declarations }
  39.     procedure UUEncode;
  40.  
  41.   published
  42.   { Published design declarations }
  43.     property InputFile:  String read FInputFileName write FInputFileName;
  44.     property OutputFile: String read FOutputFileName write FOutputFileName;
  45.  
  46.   published
  47.   { Published activation properties }
  48.     property Activate: Boolean read FActivate write Activation;
  49.  
  50.   published
  51.   { Published Event properties }
  52.     property OnError: TErrorEvent read FOnError write FOnError;
  53.     property OnSuccess: TSuccessEvent read FOnSuccess write FOnSuccess;
  54.   end;
  55.  
  56.  
  57.   TBUUDeCode = class(TDrBob)
  58.   public
  59.   { Public class declarations (override) }
  60.     constructor Create(AOwner: TComponent); override;
  61.  
  62.   private
  63.   { Private field declarations }
  64.     FActivate: Boolean;
  65.     FOnError: TErrorEvent;
  66.     FOnSuccess: TSuccessEvent;
  67.     FInputFileName: String;
  68.  
  69.   protected
  70.   { Protected method declarations }
  71.     function InputFilePChar: PChar;
  72.  
  73.   protected
  74.   { Protected activation methods }
  75.     procedure Activation(Engage: Boolean);
  76.  
  77.   public
  78.   { Public interface declarations }
  79.     procedure UUDecode;
  80.  
  81.   published
  82.   { Published design declarations }
  83.     property InputFile:  String read FInputFileName write FInputFileName;
  84.  
  85.   published
  86.   { Published activation properties }
  87.     property Activate: Boolean read FActivate write Activation;
  88.  
  89.   published
  90.   { Published Event properties }
  91.     property OnError: TErrorEvent read FOnError write FOnError;
  92.     property OnSuccess: TSuccessEvent read FOnSuccess write FOnSuccess;
  93.   end;
  94.  
  95. procedure Register;
  96.  
  97. implementation
  98. uses UUCode;
  99.  
  100.  
  101.   constructor TBUUEnCode.Create(AOwner: TComponent);
  102.   begin
  103.     if not UUCodeLoaded then
  104.       raise EUUCode.Create('TBUUEnCode: UUCode.DLL not loaded');
  105.     inherited Create(AOwner);
  106.     FActivate := False;
  107.     FAbout := 'TBUUEnCode 2.0 (c) 1995 by Dr.Bob (DrBob@pi.net)'
  108.   end {Create};
  109.  
  110.   function TBUUEnCode.InputFilePChar: PChar;
  111.   begin
  112.     Result := StrPCopy(@FInputFileName[1],FInputFileName)
  113.   end {InputFilePChar};
  114.  
  115.   function TBUUEnCode.OutputFilePChar: PChar;
  116.   begin
  117.     Result := StrPCopy(@FOutputFileName[1],FOutputFileName)
  118.   end {OutputFilePChar};
  119.  
  120.   procedure TBUUEnCode.Activation(Engage: Boolean);
  121.   begin
  122.     if Engage then
  123.     begin
  124.       FActivate := True;
  125.       Application.ProcessMessages;
  126.       UUEncode;
  127.       FActivate := False
  128.     end
  129.   end {Activate};
  130.  
  131.   procedure TBUUEnCode.UUEncode;
  132.   var Error: Word;
  133.   begin
  134.     if FInputFileName = '' then raise EUUCode.Create('InputFileName is empty');
  135.     if FOutputFileName = '' then raise EUUCode.Create('OutputFileName is empty');
  136.     Error := UUEncoder(InputFilePChar,OutputFilePChar,664,False,nil);
  137.     if Error <> 0 then
  138.     begin
  139.       if Assigned(FOnError) then FOnError(Error)
  140.       else
  141.       begin
  142.         case Error of
  143.           1: raise EUUCode.Create('UUEnCode: input file is output file');
  144.           2: raise EUUCode.Create('UUEnCode: input file does not exist');
  145.           3: raise EUUCode.Create('UUEnCode: output file exists');
  146.           4: raise EUUCode.Create('UUEnCode: could not create output file');
  147.           5: raise EUUCode.Create('UUEnCode: DLL bussy, try again later (shared buffers)')
  148.         end
  149.       end
  150.     end
  151.     else { sucess! }
  152.       if Assigned(FOnSuccess) then FOnSuccess
  153.   end {UUEncode};
  154.  
  155.  
  156.  
  157.   constructor TBUUDeCode.Create(AOwner: TComponent);
  158.   begin
  159.     if not UUCodeLoaded then
  160.       raise EUUCode.Create('TBUUDeCode: UUCode.DLL not loaded');
  161.     inherited Create(AOwner);
  162.     FActivate := False;
  163.     FAbout := 'TBUUDeCode 2.0 (c) 1995 by Dr.Bob (DrBob@pi.net)'
  164.   end {Create};
  165.  
  166.   function TBUUDeCode.InputFilePChar: PChar;
  167.   begin
  168.     Result := StrPCopy(@FInputFileName[1],FInputFileName)
  169.   end {InputFilePChar};
  170.  
  171.   procedure TBUUDeCode.Activation(Engage: Boolean);
  172.   begin
  173.     if Engage then
  174.     begin
  175.       FActivate := True;
  176.       Application.ProcessMessages;
  177.       UUDecode;
  178.       FActivate := False
  179.     end
  180.   end {Activate};
  181.  
  182.   procedure TBUUDeCode.UUDecode;
  183.   var WorkDir: String;
  184.       Error: Word;
  185.   begin
  186.     if FInputFileName = '' then raise EUUCode.Create('InputFileName is empty');
  187.     WorkDir := ExtractFilePath(FInputFileName);
  188.     if WorkDir[Length(WorkDir)] = '\' then Delete(WorkDir,Length(WorkDir),1);
  189.     ChDir(WorkDir);
  190.     Error := UUDecoder(InputFilePChar,nil);
  191.     if Error <> 0 then
  192.     begin
  193.       if Assigned(FOnError) then FOnError(Error)
  194.       else
  195.       begin
  196.         case Error of
  197.           1: raise EUUCode.Create('UUDeCode: input file is output file');
  198.           2: raise EUUCode.Create('UUDeCode: input file does not exist');
  199.           3: raise EUUCode.Create('UUDeCode: output file exists');
  200.           4: raise EUUCode.Create('UUDeCode: could not create output file');
  201.           5: raise EUUCode.Create('UUDeCode: DLL bussy, try again later (shared buffers)')
  202.         end
  203.       end
  204.     end
  205.     else { sucess! }
  206.       if Assigned(FOnSuccess) then FOnSuccess
  207.   end {UUDecode};
  208.  
  209.  
  210.   procedure Register;
  211.   begin
  212.     RegisterComponents('Dr.Bob', [TBUUEnCode,TBUUDeCode]);
  213.   end {Register};
  214. end.
  215.